home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / btb / btb.bas next >
BASIC Source File  |  1992-07-18  |  6KB  |  117 lines
  1. 10 'BTB-Binary To Basic, Edition 2.02, (c) 1990-91-92, Giuliano Artico
  2. 15 'Written by Giuliano Artico, I3LGP - Internet address: ARTICO@PDMAT1.UNIPD.IT
  3. 20 'Dipartimento di Matematica Pura e Applicata
  4. 25 'Via Belzoni 7, 35131 Padova, Italy
  5. 30 'Padova, February 15,1992
  6. 35 'Conversion of a binary file into a self-extracting BASIC file
  7. 40 'The output file may be RUN under GW-Basic or Quick Basic
  8. 45 'to reconstruct the original binary file.
  9. 50 'Options /E (ON ERROR) and /X (RESUME) are required by Quick Basic 3.0
  10. 55 'The output file may be sent via electronic mail as a text file
  11. 60 'Version 2.02 contains only minor changes with respect to 2.0
  12. 100 'Main
  13. 110 DEFINT A-W: DIM C(3),Z$(2): DEF FNA$(X)=MID$(STR$(X),2)
  14. 120 KEY OFF: GOSUB 2000: GOSUB 3000
  15. 130 PRINT: PRINT "Creating the file ";F$;". Please wait..."
  16. 140 GOSUB 6000:GOSUB 7000
  17. 150 PRINT "The file ";F$;" of" X+1 "bytes has been created successfully."
  18. 160 PRINT "That file is a BASIC program: ";
  19. 170 PRINT "if you run it (e.g. under Quick Basic),"
  20. 180 PRINT "you will get the original binary file ";A$
  21. 900 VIEW PRINT: LOCATE 23,1: END
  22. 1000 IF RIGHT$(X$,1)=" " THEN X$=LEFT$(X$,LEN(X$)-1):GOTO 1000
  23. 1001 IF LEFT$(X$,1)=" " THEN X$=MID$(X$,2): GOTO 1001 ELSE RETURN
  24. 1010 BEEP: PRINT"Error writing the file " F$: RESUME 900
  25. 2000 'Start
  26. 2010 LR=51: PP=92: E$=".BTB": V$=CHR$(34)
  27. 2020 W$=",": D$=" DATA"+V$: VI$=V$+"I"+V$: VO$=V$+"O"+V$: VR$=V$+"R"+V$
  28. 2030 FOR I=1 TO 2: READ Z$(I): NEXT
  29. 2040 X$=COMMAND$: GOSUB 1000: SWAP A$,X$: FOR I=1 TO 8: A=A+INSTR(A$,MID$("*?%+,/;=",I,1)): NEXT I: IF A>0 THEN 8000
  30. 2050 CLS: VIEW PRINT:FOR I=1 TO 2: LOCATE 2*I,41-LEN(Z$(I))\2: PRINT Z$(I): NEXT: VIEW PRINT 7 TO 25
  31. 2060 IF A$="" THEN RETURN
  32. 2070 NF=1: L=LEN(A$): A=INSTR(A$," "): IF A>0 THEN NF=2: X$=RIGHT$(A$,L-A): A$=LEFT$(A$,A-1) ELSE RETURN
  33. 2080 GOSUB 1000: A=INSTR(X$," "): IF A>0 THEN X$=LEFT$(X$,A): GOSUB 1000
  34. 2090 F$=X$: RETURN
  35. 2100 DATA"BTB-Binary To Basic, Edition 2.02, (c) 1990-91-92, Giuliano Artico"
  36. 2110 DATA"Conversion of a binary file into a self-extracting BASIC file
  37. 3000 'Opening files
  38. 3010 IF NF=0 THEN NB=0: NP=0: LINE INPUT "Enter input file name (binary file): ",A$
  39. 3020 GOSUB 5000: X$=A$: GOSUB 4000
  40. 3030 IF E>0 THEN BEEP: PRINT "Error opening input file": IF NF>0 THEN 900 ELSE 3010
  41. 3040 CLOSE: OPEN "R",1,A$,LR: IF LOF(1)>40000! THEN PRINT "The input file's size is too large": GOTO 900
  42. 3050 FIELD 1,LR AS R$: XF=LOF(1): LC=INT(XF/LR): X=XF-LR*CSNG(LC): A=X: N=A\3:R=A MOD 3
  43. 3060 X$=F$: GOSUB 4000: IF E>0 THEN 3110
  44. 3070 BEEP: PRINT "Caution! The output file ";F$;" already exists."
  45. 3080 PRINT "Do you want to overwrite it? (Y/N)  N"CHR$(29);
  46. 3090 Z$=INKEY$:IF Z$="" THEN 3090 ELSE IF Z$=CHR$(27) THEN 900
  47. 3100 IF Z$="y" OR Z$="Y" THEN PRINT "Y": GOTO 3130 ELSE 900
  48. 3110 IF E=53 THEN 3130
  49. 3120 BEEP: PRINT "Error opening output file": GOTO 900
  50. 3130 ON ERROR GOTO 1010:CLOSE 2: OPEN "O",2,F$: RETURN
  51. 4000 'Testing files' existance
  52. 4010 ON ERROR GOTO 4020: OPEN "I",3,X$: E=0: GOTO 4030
  53. 4020 E=ERR: RESUME 4030
  54. 4030 CLOSE 3: ON ERROR GOTO 0: RETURN
  55. 5000 'Extract output file name
  56. 5010 SWAP A$,X$: GOSUB 1000: SWAP A$,X$: IF A$="" THEN 900
  57. 5020 L=LEN(A$): FOR I=L TO 1 STEP -1: J=ASC(MID$(A$,I,1))
  58. 5030 IF J=46 AND NP=0 THEN NP=I
  59. 5040 IF (J=58 OR J=92) AND NB=0 THEN NB=I
  60. 5050 NEXT: IF NP<=NB THEN NP=L+1
  61. 5060 A0$=MID$(A$,NB+1): IF NF<2 THEN F$=LEFT$(A0$,NP-NB-1)+E$
  62. 5070 RETURN
  63. 6000 'Extracting routine
  64. 6010 PRINT #2,"0 DEFINT A-W:READ A$,X,L,A,N,R:IF R>2 OR A>"FNA$(LR-1);
  65. 6020 PRINT #2,"OR X<>L*"FNA$(LR)"!+A OR A<>N*3+R THEN 18"
  66. 6030 PRINT #2,"1 ON ERROR GOTO 2:OPEN"VI$",1,A$:BEEP:PRINT"V$;
  67. 6040 PRINT #2,"Remove the file "V$"A$:END"
  68. 6050 PRINT #2,"2 IF ERR=53 THEN RESUME 3 ELSE RESUME 17"
  69. 6060 PRINT #2,"3 ON ERROR GOTO 0:PRINT"V$;
  70. 6070 PRINT #2,"Reconstruction of the file "V$"A$"V$". Please wait..."
  71. 6080 PRINT #2,"4 CLOSE:OPEN"VR$",1,A$,3:FIELD 1,3 AS R$:M=16"
  72. 6090 PRINT #2,"5 FOR I=1 TO L+1:H=0:READ B$:IF LEN(B$)<69 THEN 18"
  73. 6100 PRINT #2,"6 IF I=L+1 THEN IF R>0 THEN F=1:M=N ELSE M=N-1"
  74. 6110 PRINT #2,"7 FOR J=0 TO M:FOR K=1 TO 4:";
  75. 6120 PRINT #2,"C(K)=ASC(MID$(B$,J*4+K,1))-35:IF C(K)>63 THEN 18"
  76. 6130 PRINT #2,"8 NEXT:P1=C(2) AND 3:P2=C(2) AND 60:";
  77. 6140 PRINT #2,"Q1=C(3) AND 15:Q2=C(3) AND 48"
  78. 6150 PRINT #2,"9 U=C(1) OR P1*64:V=P2\4 OR Q1*16:W=Q2\16 OR C(4)*4:";
  79. 6160 PRINT #2,"X$=CHR$(U)+CHR$(V)+CHR$(W)"
  80. 6170 PRINT #2,"10 G=U+V+W:H=H+G:Y=Y+G:IF F=1 AND J=M THEN 13"
  81. 6180 PRINT #2,"11 LSET R$=X$:PUT 1:NEXT:";
  82. 6190 PRINT #2,"IF H MOD "FNA$(PP)"<>ASC(MID$(B$,69))-35 THEN 18"
  83. 6200 PRINT #2,"12 NEXT:GOTO 15"
  84. 6210 PRINT #2,"13 X$=LEFT$(X$,R):CLOSE:OPEN"VR$",1,A$,1:FIELD 1,1 AS R$"
  85. 6220 PRINT #2,"14 FOR I=1 TO R:LSET R$=MID$(X$,I,1):PUT 1,LOF(1)+1:NEXT"
  86. 6230 PRINT #2,"15 CLOSE:READ X:IF X<>Y THEN PRINT"V$;
  87. 6240 PRINT #2,"Check sum error!"V$":GOTO 19"
  88. 6250 PRINT #2,"16 PRINT"V$"Reconstruction completed OK"V$":END"
  89. 6260 PRINT #2,"17 PRINT"V$"Disk error"V$":END"
  90. 6270 PRINT #2,"18 PRINT"V$"Data error at line"V$"20+I"
  91. 6280 PRINT #2,"19 BEEP:IF I>0 THEN CLOSE:KILL A$": RETURN
  92. 7000 'Encoding
  93. 7010 PRINT #2, "20 END:";
  94. 7020 PRINT #2,D$A0$V$W$FNA$(XF)W$FNA$(LC)W$FNA$(A)W$FNA$(N)W$FNA$(R)
  95. 7030 FOR I=1 TO LC+1: H=0: GET 1,I: B$=R$: PRINT #2,FNA$(20+I) D$;
  96. 7040 IF I=LC+1 THEN B$=LEFT$(B$,A)+STRING$(51-A,CHR$(0))
  97. 7050 FOR J=0 TO 16: FOR K=1 TO 3: C(K)=ASC(MID$(B$,3*J+K,1)): NEXT K
  98. 7060 H=H+C(1)+C(2)+C(3)
  99. 7070 P1=C(1) AND 63: P2=C(1) AND 192
  100. 7080 Q1=C(2) AND 15: Q2=C(2) AND 240
  101. 7090 R1=C(3) AND 3: R2=C(3) AND 252
  102. 7100 X$=CHR$(35+P1)+CHR$(35+(P2\64 OR Q1*4))
  103. 7110 X$=X$+CHR$(35+(Q2\16 OR R1*16))+CHR$(35+R2\4)
  104. 7120 PRINT #2,X$;
  105. 7130 NEXT J:XC=XC+H: PRINT #2,CHR$((H MOD PP)+35): NEXT I
  106. 7140 PRINT #2, FNA$(20+I);" DATA";XC: X=LOF(2): CLOSE: RETURN
  107. 8000 'Help
  108. 8010 PRINT Z$(1): PRINT
  109. 8020 PRINT TAB(4) "BTB [InputFileName] [OutputFileName] [/h]": PRINT
  110. 8030 PRINT TAB(4) "[InputFileName]  is the binary file to be processed"
  111. 8040 PRINT TAB(4) "[OutputFileName] is the target Basic file to be generated"
  112. 8050 PRINT TAB(4) "[InputFileName] and [OutputFileName] may include drive and directory name"
  113. 8060 PRINT TAB(4) "If omitted, [OutputFileName] is equal to [InputFileName] with extension .BTB"
  114. 8070 PRINT
  115. 8080 PRINT TAB(4)"For comments or questions use my Internet address: ARTICO@PDMAT1.UNIPD.IT"
  116. 8090 GOTO 900
  117.